Fix #644: Use Buffer.t instead of Bi_outbuf.t (#645)

This should make Kappa compatible with the latest version of yojson.

Since ocaml-community/yojson#74, yojson does
not rely on biniou buffers.

The main drawback seems to be that `JsonUtil.write_to_channel` now
writes everything to the memory (in a `Buffer.t`) before dumping the
buffer to the channel.

core/KaSa_rep/frontend/ckappa_sig.ml

@@ -146,12 +146,12 @@ let rule_id_of_json json =
     raise (Yojson.Basic.Util.Type_error (JsonUtil.build_msg "rule id",json))
 
 let write_c_rule_id ob f =
-  Yojson.Basic.to_outbuf ob (rule_id_to_json f)
+  Yojson.Basic.to_buffer ob (rule_id_to_json f)
 
 let string_of_c_rule_id ?(len = 1024) x =
-  let ob = Bi_outbuf.create len in
+  let ob = Buffer.create len in
   write_c_rule_id ob x;
-  Bi_outbuf.contents ob
+  Buffer.contents ob
 
 let read_c_rule_id p lb =
   rule_id_of_json (Yojson.Basic.from_lexbuf ~stream:true p lb)

core/KaSa_rep/frontend/ckappa_sig.mli

@@ -37,7 +37,7 @@ type c_counter_name
 
 val rule_id_to_json : c_rule_id -> Yojson.Basic.t
 val rule_id_of_json : Yojson.Basic.t -> c_rule_id
-val write_c_rule_id : Bi_outbuf.t -> c_rule_id -> unit
+val write_c_rule_id : Buffer.t -> c_rule_id -> unit
 val string_of_c_rule_id : ?len:int -> c_rule_id -> string
 val read_c_rule_id : Yojson.Safe.lexer_state -> Lexing.lexbuf -> c_rule_id
 val c_rule_id_of_string : string -> c_rule_id

core/api/kamoha_client.ml

@@ -56,7 +56,7 @@ class virtual new_client ~post mailbox :
   method virtual is_running : bool
 
   method private message :
-    type a. a handle -> (Bi_outbuf.t -> unit) ->
+    type a. a handle -> (Buffer.t -> unit) ->
     (a, Result_util.message list) Result_util.t Lwt.t =
     fun handle request ->
     if self#is_running then

core/api/kappa_facade.ml

@@ -52,7 +52,7 @@ type t =
     mutable species : (float*User_graph.connected_component) list Mods.StringMap.t;
     mutable files : string list Mods.StringMap.t ;
     mutable error_messages : Result_util.message list ;
-    (*mutable*) trace : Bi_outbuf.t ;
+    (*mutable*) trace : Buffer.t ;
     inputs_buffer : Buffer.t;
     inputs_form : Format.formatter;
     ast : Ast.parsing_compil;
@@ -76,7 +76,7 @@ let create_t ~log_form ~log_buffer ~contact_map ~inputs_buffer ~inputs_form
   species = Mods.StringMap.empty;
   files = Mods.StringMap.empty;
   error_messages = [];
-  trace = Bi_outbuf.create 1024;
+  trace = Buffer.create 1024;
   inputs_buffer; inputs_form; ast; contact_map; env; graph; state; init_l;
   lastyield;
 }
@@ -237,9 +237,8 @@ let outputs (simulation : t) =
   | Data.Log s -> Format.fprintf simulation.log_form "%s@." s
   | Data.Warning (pos,msg) -> Data.print_warning ?pos simulation.log_form msg
   | Data.TraceStep st ->
-    let () = Bi_outbuf.add_char simulation.trace
-        (if simulation.trace.Bi_outbuf.o_len = 0 &&
-            simulation.trace.Bi_outbuf.o_offs = 0 then '[' else ',') in
+    let () = Buffer.add_char simulation.trace
+        (if Buffer.length simulation.trace = 0 then '[' else ',') in
     Trace.write_step simulation.trace st
 
 let interactive_outputs formatter t = function
@@ -560,27 +559,27 @@ let efficiency t = Counter.get_efficiency t.counter
 let get_raw_trace t =
   JsonUtil.string_of_write
     (fun ob t ->
-       let () = Bi_outbuf.add_char ob '{' in
+       let () = Buffer.add_char ob '{' in
        let () = JsonUtil.write_field
            "dict" (fun ob () ->
-               let () = Bi_outbuf.add_char ob '{' in
-               let () = Bi_outbuf.add_string ob Agent.json_dictionnary in
+               let () = Buffer.add_char ob '{' in
+               let () = Buffer.add_string ob Agent.json_dictionnary in
                let () = JsonUtil.write_comma ob in
-               let () = Bi_outbuf.add_string ob Instantiation.json_dictionnary in
+               let () = Buffer.add_string ob Instantiation.json_dictionnary in
                let () = JsonUtil.write_comma ob in
-               let () = Bi_outbuf.add_string
+               let () = Buffer.add_string
                    ob Trace.Simulation_info.json_dictionnary in
                let () = JsonUtil.write_comma ob in
-               let () = Bi_outbuf.add_string ob Trace.json_dictionnary in
-               Bi_outbuf.add_char ob '}'
+               let () = Buffer.add_string ob Trace.json_dictionnary in
+               Buffer.add_char ob '}'
              ) ob () in
        let () = JsonUtil.write_comma ob in
        let () = JsonUtil.write_field
            "model" Yojson.Basic.write_json ob (Model.to_yojson t.env) in
        let () = JsonUtil.write_comma ob in
        let () = JsonUtil.write_field
-           "trace" Bi_outbuf.add_string ob (Bi_outbuf.contents t.trace) in
-       Bi_outbuf.add_char2 ob ']' '}'
+           "trace" Buffer.add_string ob (Buffer.contents t.trace) in
+       Buffer.add_string ob "]}"
     ) t
 
 let get_raw_ast t =

core/api/kasa_client.ml

@@ -49,13 +49,13 @@ class new_client ~is_running ~post (mailbox : mailbox) :
     method private raw_message post request =
       if is_running () then
         let result,feeder = Lwt.task () in
-        let outbuf = Bi_outbuf.create 1024 in
-        let () = Bi_outbuf.add_string outbuf "{id:" in
-        let () = Bi_outbuf.add_string outbuf (string_of_int id) in
-        let () = Bi_outbuf.add_string outbuf ",data:" in
+        let outbuf = Buffer.create 1024 in
+        let () = Buffer.add_string outbuf "{id:" in
+        let () = Buffer.add_string outbuf (string_of_int id) in
+        let () = Buffer.add_string outbuf ",data:" in
         let () = request outbuf in
-        let () = Bi_outbuf.add_string outbuf "}" in
-        let () = post (Bi_outbuf.contents outbuf) in
+        let () = Buffer.add_string outbuf "}" in
+        let () = post (Buffer.contents outbuf) in
         let () = Hashtbl.replace mailbox id feeder in
         let () = id <- id+1 in
         result
@@ -68,13 +68,13 @@ class new_client ~is_running ~post (mailbox : mailbox) :
                 Exit)
              Exception_without_parameter.empty_error_handler)
     method private message request =
-      self#raw_message post (fun outb -> Yojson.Basic.to_outbuf outb request)
+      self#raw_message post (fun outb -> Yojson.Basic.to_buffer outb request)
 
     method init_static_analyser_raw compil =
       let request outbuf =
-        let () = Bi_outbuf.add_string outbuf "[ \"INIT\", " in
-        let () = Bi_outbuf.add_string outbuf compil in
-        Bi_outbuf.add_string outbuf "]" in
+        let () = Buffer.add_string outbuf "[ \"INIT\", " in
+        let () = Buffer.add_string outbuf compil in
+        Buffer.add_string outbuf "]" in
       Lwt_result.bind_result
         (self#raw_message post request)
         (function

core/api/switchman_client.ml

@@ -152,7 +152,7 @@ class virtual new_client ~is_running ~post mailbox = object(self)
   val mutable id = 0
 
   method private message :
-    type a. a handle -> (Bi_outbuf.t -> unit) ->
+    type a. a handle -> (Buffer.t -> unit) ->
     (a, Result_util.message list) Result_util.t Lwt.t =
     fun handle request ->
     if is_running () then

core/api/switchman_client.mli

@@ -127,7 +127,7 @@ class virtual new_client :
     method private message :
       'a.
         'a handle ->
-        (Bi_outbuf.t -> unit) ->
+        (Buffer.t -> unit) ->
         ('a, Kappa_generic_toolset.Result_util.message list)
         Kappa_generic_toolset.Result_util.t Lwt.t
     method project_overwrite :

core/dataStructures/jsonUtil.ml

@@ -6,15 +6,17 @@
 (* |_|\_\ * GNU Lesser General Public License Version 3                       *)
 (******************************************************************************)
 
+let initial_buffer_size = 0x1000
+
 let write_to_channel f d x =
-  let b = Bi_outbuf.create_channel_writer d in
+  let b = Buffer.create initial_buffer_size in
   let () = f b x in
-  Bi_outbuf.flush_channel_writer b
+  Buffer.output_buffer d b
 
 let string_of_write f ?(len = 1024) x =
-  let ob = Bi_outbuf.create len in
+  let ob = Buffer.create len in
   let () = f ob x in
-  Bi_outbuf.contents ob
+  Buffer.contents ob
 
 let read_of_string f x =
   let lex_st = Yojson.Basic.init_lexer () in
@@ -89,18 +91,18 @@ let to_list ?error_msg:(error_msg=build_msg "list") of_json = function
   | `Null -> []
   | x -> raise (Yojson.Basic.Util.Type_error (error_msg,x))
 
-let write_comma ob = Bi_outbuf.add_char ob ','
+let write_comma ob = Buffer.add_char ob ','
 
 let rec iter2 f_elt x = function
   | [] -> ()
   | y :: l -> write_comma x; f_elt x y; iter2 f_elt x l
 
 let write_list f ob l =
-  let () = Bi_outbuf.add_char ob '[' in
+  let () = Buffer.add_char ob '[' in
   let () = match l with
     | [] -> ()
     | y :: l -> f ob y; iter2 f ob l in
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let of_array to_json a =
   `List (Array.fold_right (fun x acc -> to_json x::acc) a [])
@@ -111,12 +113,12 @@ let to_array ?error_msg:(error_msg=build_msg "array") of_json = function
   | x -> raise (Yojson.Basic.Util.Type_error (error_msg,x))
 
 let write_array f ob l =
-  let () = Bi_outbuf.add_char ob '[' in
+  let () = Buffer.add_char ob '[' in
   let () = if Array.length l > 0 then f ob l.(0) in
   let () = Tools.iteri
       (fun i -> let () = write_comma ob in f ob l.(succ i))
       (pred (Array.length l)) in
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let rec iter_seq ob = function
   | [] -> ()
@@ -126,11 +128,11 @@ let rec iter_seq ob = function
     iter_seq ob q
 
 let write_sequence ob l =
-  let () = Bi_outbuf.add_char ob '[' in
+  let () = Buffer.add_char ob '[' in
   let () = match l with
     | [] -> ()
     | f::q -> let () = f ob in iter_seq ob q in
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let read_variant read_id read st b =
   let () = Yojson.Basic.read_lbr st b in
@@ -164,7 +166,7 @@ let to_assoc
 
 let write_field na f ob x =
   let () = Yojson.Basic.write_string ob na in
-  let () = Bi_outbuf.add_char ob ':' in
+  let () = Buffer.add_char ob ':' in
   f ob x
 
 let of_pair ?(lab1="first") ?(lab2="second") to_json1 to_json2 (a,b) =
@@ -206,11 +208,11 @@ let to_pair ?lab1:(lab1="first") ?lab2:(lab2="second")
     raise (Yojson.Basic.Util.Type_error (error_msg,x))
 
 let write_compact_pair f g ob (x,y) =
-  let () = Bi_outbuf.add_char ob '[' in
+  let () = Buffer.add_char ob '[' in
   let () = f ob x in
   let () = write_comma ob in
   let () = g ob y in
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let read_compact_pair f g st b =
   let () = Yojson.Basic.read_lbr st b in

core/dataStructures/jsonUtil.mli

@@ -8,8 +8,8 @@
 
 (** Parsing utils *)
 
-val write_to_channel: (Bi_outbuf.t -> 'a -> unit) -> out_channel -> 'a -> unit
-val string_of_write: (Bi_outbuf.t -> 'a -> unit) -> ?len:int -> 'a -> string
+val write_to_channel: (Buffer.t -> 'a -> unit) -> out_channel -> 'a -> unit
+val string_of_write: (Buffer.t -> 'a -> unit) -> ?len:int -> 'a -> string
 
 val read_of_string:
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a) -> string -> 'a
@@ -22,7 +22,7 @@ val read_next_item :
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a) ->
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a)
 
-val write_comma: Bi_outbuf.t -> unit
+val write_comma: Buffer.t -> unit
 
 (** Jsonify simple types *)
 
@@ -46,7 +46,7 @@ val to_option: (Yojson.Basic.t -> 'a) -> Yojson.Basic.t -> 'a option
 (** Beware: `Null is reserved for None *)
 
 val write_option:
-  (Bi_outbuf.t -> 'a -> unit) -> Bi_outbuf.t -> 'a option -> unit
+  (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a option -> unit
 
 val read_option:
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a) ->
@@ -57,16 +57,16 @@ val of_list: ('a -> Yojson.Basic.t) -> 'a list -> Yojson.Basic.t
 val to_list:
   ?error_msg:string -> (Yojson.Basic.t -> 'a) -> Yojson.Basic.t -> 'a list
 
-val write_list: (Bi_outbuf.t -> 'a -> unit) -> Bi_outbuf.t -> 'a list -> unit
+val write_list: (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a list -> unit
 
 val of_array: ('a -> Yojson.Basic.t) -> 'a array -> Yojson.Basic.t
 
 val to_array:
   ?error_msg:string -> (Yojson.Basic.t -> 'a) -> Yojson.Basic.t -> 'a array
 
-val write_array: (Bi_outbuf.t -> 'a -> unit) -> Bi_outbuf.t -> 'a array -> unit
+val write_array: (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a array -> unit
 
-val write_sequence: Bi_outbuf.t -> (Bi_outbuf.t -> unit) list -> unit
+val write_sequence: Buffer.t -> (Buffer.t -> unit) list -> unit
 
 val read_variant:
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a) ->
@@ -84,7 +84,7 @@ val to_assoc:
   Yojson.Basic.t -> 'a list
 
 val write_field:
-  string -> (Bi_outbuf.t -> 'a -> unit) -> Bi_outbuf.t -> 'a -> unit
+  string -> (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a -> unit
 
 val of_pair:
   ?lab1:string -> ?lab2:string ->
@@ -97,8 +97,8 @@ val to_pair:
   Yojson.Basic.t -> 'a * 'b
 
 val write_compact_pair:
-  (Bi_outbuf.t -> 'a -> unit) -> (Bi_outbuf.t -> 'b -> unit) ->
-  Bi_outbuf.t -> 'a * 'b -> unit
+  (Buffer.t -> 'a -> unit) -> (Buffer.t -> 'b -> unit) ->
+  Buffer.t -> 'a * 'b -> unit
 
 val read_compact_pair:
   (Yojson.Basic.lexer_state -> Lexing.lexbuf -> 'a) ->

core/dataStructures/locality.ml

@@ -135,12 +135,12 @@ let annot_of_yojson ?filenames f = function
   | `Assoc [ "val", x ] -> (f x, dummy)
   | x -> raise (Yojson.Basic.Util.Type_error ("Invalid location",x))
 
-let write_range ob f = Yojson.Basic.to_outbuf ob (to_compact_yojson None f)
+let write_range ob f = Yojson.Basic.to_buffer ob (to_compact_yojson None f)
 
 let string_of_range ?(len = 1024) x =
-  let ob = Bi_outbuf.create len in
+  let ob = Buffer.create len in
   write_range ob x;
-  Bi_outbuf.contents ob
+  Buffer.contents ob
 
 let read_range p lb =
   of_compact_yojson

core/dataStructures/locality.mli

@@ -41,12 +41,12 @@ val annot_to_yojson :
   ?filenames : int Mods.StringMap.t ->
   ('a -> Yojson.Basic.t) -> 'a annot -> Yojson.Basic.t
 
-val write_position : Bi_outbuf.t -> position -> unit
+val write_position : Buffer.t -> position -> unit
 
 val read_position :
   Yojson.Safe.lexer_state -> Lexing.lexbuf -> position
 
-val write_range : Bi_outbuf.t -> t -> unit
+val write_range : Buffer.t -> t -> unit
   (** Output a JSON value of type {!t}. *)
 
 val string_of_range : ?len:int -> t -> string

core/dataStructures/nbr.ml

@@ -187,12 +187,12 @@ let of_yojson = function
   | x -> raise (Yojson.Basic.Util.Type_error ("Not an Nbr",x))
 
 let write_t ob f =
-  Yojson.Basic.to_outbuf ob (to_yojson f)
+  Yojson.Basic.to_buffer ob (to_yojson f)
 
 let string_of_t ?(len = 1024) x =
-  let ob = Bi_outbuf.create len in
+  let ob = Buffer.create len in
   write_t ob x;
-  Bi_outbuf.contents ob
+  Buffer.contents ob
 
 let read_t p lb =
   of_yojson (Yojson.Basic.from_lexbuf ~stream:true p lb)

core/dataStructures/nbr.mli

@@ -62,7 +62,7 @@ val to_yojson : t -> Yojson.Basic.t
 val of_yojson : Yojson.Basic.t -> t
 (** @raise Yojson.Basic.Util.Type_error if incorrect *)
 
-val write_t : Bi_outbuf.t -> t -> unit
+val write_t : Buffer.t -> t -> unit
 (** Output a JSON value of type {!t}. *)
 
 val string_of_t : ?len:int -> t -> string