snapshot

Author: bobzhang

lib/4.06.1/bsb.ml

@@ -12317,7 +12317,7 @@ let nl buf =
     - not readable 
  *)  
 
-let make_encoding length buf =
+let make_encoding length buf : Ext_buffer.t -> int -> unit =
   let max_range = length lsl 1 + 1 in 
   if max_range <= 0xff then begin 
     Ext_buffer.add_char buf '1';
@@ -12340,44 +12340,46 @@ let make_encoding length buf =
   Strictly speaking, [tmp_buf1] is not needed
 *)
 let encode_single (db : Bsb_db.map) (buf : Ext_buffer.t) =    
-  nl buf ; (* module name section *)
+  (* module name section *)  
   let len = Map_string.cardinal db in 
   Ext_buffer.add_string_char buf (string_of_int len) '\n';
-  let mapping = Hash_string.create 50 in 
-  Map_string.iter db (fun name {dir} ->  
-      Ext_buffer.add_string_char buf name '\n'; 
-      if not (Hash_string.mem mapping dir) then
-        Hash_string.add mapping dir (Hash_string.length mapping)
-    ); 
-  let length = Hash_string.length mapping in   
-  let rev_mapping = Array.make length "" in 
-  Hash_string.iter mapping (fun k i -> Array.unsafe_set rev_mapping i k);
-  (* directory name section *)
-  Ext_array.iter rev_mapping (fun s -> Ext_buffer.add_string_char buf s '\t');
-  nl buf; (* module name info section *)
-  let len_encoding = make_encoding length buf in 
-  Map_string.iter db (fun _ module_info ->       
-      len_encoding buf 
-        (Hash_string.find_exn  mapping module_info.dir lsl 1 + Obj.magic module_info.case ))      
-    
+  if len <> 0 then begin 
+    let mapping = Hash_string.create 50 in 
+    Map_string.iter db (fun name {dir} ->  
+        Ext_buffer.add_string_char buf name '\n'; 
+        if not (Hash_string.mem mapping dir) then
+          Hash_string.add mapping dir (Hash_string.length mapping)
+      ); 
+    let length = Hash_string.length mapping in   
+    let rev_mapping = Array.make length "" in 
+    Hash_string.iter mapping (fun k i -> Array.unsafe_set rev_mapping i k);
+    (* directory name section *)
+    Ext_array.iter rev_mapping (fun s -> Ext_buffer.add_string_char buf s '\t');
+    nl buf; (* module name info section *)
+    let len_encoding = make_encoding length buf in 
+    Map_string.iter db (fun _ module_info ->       
+        len_encoding buf 
+          (Hash_string.find_exn  mapping module_info.dir lsl 1 + Obj.magic module_info.case ));      
+    nl buf 
+  end
 let encode (dbs : Bsb_db.t) buf =     
   encode_single dbs.lib buf ;
   encode_single dbs.dev buf 
-  (* Ext_buffer.add_char_string buf '\n' (string_of_int (Array.length dbs)); 
-  Ext_array.iter dbs (fun x ->  encode_single x  buf) *)
-  
 
-(* TODO: shall we avoid writing such file (checking the digest) *)
+
+(*  shall we avoid writing such file (checking the digest)?
+  It is expensive to start scanning the whole code base,
+  we should we avoid it in the first place, if we do start scanning,
+  this operation seems affordable
+ *)
 let write_build_cache ~dir (bs_files : Bsb_db.t)  : string = 
   let oc = open_out_bin (Filename.concat dir bsbuild_cache) in 
   let buf = Ext_buffer.create 100_000 in 
   encode bs_files buf ; 
-  let digest = Ext_buffer.digest buf in 
-  let hex_digest = Digest.to_hex digest in
-  output_string oc digest;
   Ext_buffer.output_buffer oc buf;
   close_out oc; 
-  hex_digest
+  let digest = Ext_buffer.digest buf in 
+  Digest.to_hex digest 
 
 end
 module Ext_digest : sig 

lib/4.06.1/bsb_helper.ml

@@ -1787,67 +1787,6 @@ let parse_exn  (speclist : t) anonfun errmsg =
  *)
 
 end
-module Ext_digest : sig 
-#1 "ext_digest.mli"
-(* Copyright (C) 2019- Authors of BuckleScript
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-
- val length : int 
-
- val hex_length : int
-end = struct
-#1 "ext_digest.ml"
-(* Copyright (C) 2019- Authors of BuckleScript
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-
- let length = 16
-
- let hex_length = 32
-end
 module Ext_pervasives : sig 
 #1 "ext_pervasives.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -3304,19 +3243,7 @@ module Bsb_db_decode : sig
 
 type t
 
-type group = {
-   modules : string array ; 
-   dir_length : int ;
-   dir_info_offset : int ; 
-   module_info_offset : int ;
- }
-
-(* exposed only for testing *)
-val decode_internal : 
-  string -> 
-  int ref ->
-  group array 
-
+type group 
 
 
 val read_build_cache : 
@@ -3363,49 +3290,49 @@ end = struct
  let bsbuild_cache = Literals.bsbuild_cache
 
 
- type group = {
-   modules : string array ; 
-   dir_length : int;
-   dir_info_offset : int ; 
-   module_info_offset : int;
- }
+type group = 
+  | Dummy 
+  | Group of {
+      modules : string array ; 
+      dir_length : int;
+      dir_info_offset : int ; 
+      module_info_offset : int;
+    }
 
-type t = group array * string (* string is whole content*)
+type t = { 
+  lib : group ;
+  dev : group ; 
+  content : string (* string is whole content*)
+}
 
 
 type cursor = int ref 
 
 
 (*TODO: special case when module_count is zero *)
-let rec decode_internal (x : string) (offset : cursor) =   
-  (* let len = Ext_pervasives.parse_nat_of_string x offset in  
-  incr offset; *)
+let rec decode_internal (x : string) : t =   
+  let (offset : cursor)  = ref 0 in 
   let lib = decode_single x offset in 
   let dev = decode_single x offset in
-  [|lib;dev|] 
-  (* if len = 1 then [|first|]
-  else 
-    let result = Array.make len first in 
-    for i = 1 to len - 1 do 
-      Array.unsafe_set result i (decode_single x offset)
-    done ;
-    result
-   *)
+  {lib; dev; content = x}
+
 and decode_single (x : string) (offset : cursor) : group = 
   let module_number = Ext_pervasives.parse_nat_of_string x offset in 
   incr offset;
-  let modules = decode_modules x offset module_number in 
-  let dir_info_offset = !offset in 
-  let module_info_offset = 
-    String.index_from x dir_info_offset '\n'  + 1 in
-  let dir_length = Char.code x.[module_info_offset] - 48 (* Char.code '0'*) in
-  offset := 
-    module_info_offset +
-    1 +
-    dir_length * module_number +
-    1 
+  if module_number <> 0 then begin 
+    let modules = decode_modules x offset module_number in 
+    let dir_info_offset = !offset in 
+    let module_info_offset = 
+      String.index_from x dir_info_offset '\n'  + 1 in
+    let dir_length = Char.code x.[module_info_offset] - 48 (* Char.code '0'*) in
+    offset := 
+      module_info_offset +
+      1 +
+      dir_length * module_number +
+      1 
     ;
-  { modules ; dir_info_offset; module_info_offset ; dir_length}
+    Group { modules ; dir_info_offset; module_info_offset ; dir_length}
+  end else Dummy
 and decode_modules (x : string) (offset : cursor) module_number : string array =   
   let result = Array.make module_number "" in 
   let last = ref !offset in 
@@ -3431,7 +3358,7 @@ and decode_modules (x : string) (offset : cursor) module_number : string array =
 let read_build_cache ~dir  : t =   
   let all_content = 
     Ext_io.load_file (Filename.concat dir bsbuild_cache) in   
-  decode_internal all_content (ref (Ext_digest.length + 1)), all_content
+  decode_internal all_content 
 
 
 
@@ -3442,11 +3369,13 @@ type module_info =  {
 
 
 let find_opt 
-  ((sorteds,whole) : t )  
-    (i : int) (key : string) 
+  ({content = whole} as db : t )  
+    lib (key : string) 
     : module_info option = 
-  let group = sorteds.(i) in 
-  let i = Ext_string_array.find_sorted  group.modules key in 
+  match if lib then db.lib else db.dev with  
+  | Dummy -> None
+  | Group ({modules ;} as group) ->
+  let i = Ext_string_array.find_sorted  modules key in 
   match i with 
   | None -> None 
   | Some count ->     
@@ -3472,12 +3401,12 @@ let find_opt
     Some {case ; dir_name = String.sub whole dir_name_start (dir_name_finish - dir_name_start)}
 
 let find db dependent_module is_not_lib_dir =         
-  let opt = find_opt db 0 dependent_module in 
+  let opt = find_opt db true dependent_module in 
   match opt with 
   | Some _ -> opt
   | None -> 
     if is_not_lib_dir then 
-      find_opt db 1 dependent_module 
+      find_opt db false dependent_module 
     else None       
 end
 module Ext_filename : sig 

lib/4.06.1/bsb_helper.ml.d

@@ -1 +1 @@
-../lib/4.06.1/bsb_helper.ml: ./bsb_helper/bsb_db_decode.ml ./bsb_helper/bsb_db_decode.mli ./bsb_helper/bsb_helper_arg.ml ./bsb_helper/bsb_helper_arg.mli ./bsb_helper/bsb_helper_depfile_gen.ml ./bsb_helper/bsb_helper_depfile_gen.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_namespace_encode.ml ./ext/ext_namespace_encode.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/literals.ml ./ext/literals.mli ./main/bsb_helper_main.ml ./main/bsb_helper_main.mli 
+../lib/4.06.1/bsb_helper.ml: ./bsb_helper/bsb_db_decode.ml ./bsb_helper/bsb_db_decode.mli ./bsb_helper/bsb_helper_arg.ml ./bsb_helper/bsb_helper_arg.mli ./bsb_helper/bsb_helper_depfile_gen.ml ./bsb_helper/bsb_helper_depfile_gen.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_namespace_encode.ml ./ext/ext_namespace_encode.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/literals.ml ./ext/literals.mli ./main/bsb_helper_main.ml ./main/bsb_helper_main.mli 

lib/4.06.1/unstable/bsb_native.ml

@@ -12466,7 +12466,7 @@ let nl buf =
     - not readable 
  *)  
 
-let make_encoding length buf =
+let make_encoding length buf : Ext_buffer.t -> int -> unit =
   let max_range = length lsl 1 + 1 in 
   if max_range <= 0xff then begin 
     Ext_buffer.add_char buf '1';
@@ -12489,44 +12489,46 @@ let make_encoding length buf =
   Strictly speaking, [tmp_buf1] is not needed
 *)
 let encode_single (db : Bsb_db.map) (buf : Ext_buffer.t) =    
-  nl buf ; (* module name section *)
+  (* module name section *)  
   let len = Map_string.cardinal db in 
   Ext_buffer.add_string_char buf (string_of_int len) '\n';
-  let mapping = Hash_string.create 50 in 
-  Map_string.iter db (fun name {dir} ->  
-      Ext_buffer.add_string_char buf name '\n'; 
-      if not (Hash_string.mem mapping dir) then
-        Hash_string.add mapping dir (Hash_string.length mapping)
-    ); 
-  let length = Hash_string.length mapping in   
-  let rev_mapping = Array.make length "" in 
-  Hash_string.iter mapping (fun k i -> Array.unsafe_set rev_mapping i k);
-  (* directory name section *)
-  Ext_array.iter rev_mapping (fun s -> Ext_buffer.add_string_char buf s '\t');
-  nl buf; (* module name info section *)
-  let len_encoding = make_encoding length buf in 
-  Map_string.iter db (fun _ module_info ->       
-      len_encoding buf 
-        (Hash_string.find_exn  mapping module_info.dir lsl 1 + Obj.magic module_info.case ))      
-    
+  if len <> 0 then begin 
+    let mapping = Hash_string.create 50 in 
+    Map_string.iter db (fun name {dir} ->  
+        Ext_buffer.add_string_char buf name '\n'; 
+        if not (Hash_string.mem mapping dir) then
+          Hash_string.add mapping dir (Hash_string.length mapping)
+      ); 
+    let length = Hash_string.length mapping in   
+    let rev_mapping = Array.make length "" in 
+    Hash_string.iter mapping (fun k i -> Array.unsafe_set rev_mapping i k);
+    (* directory name section *)
+    Ext_array.iter rev_mapping (fun s -> Ext_buffer.add_string_char buf s '\t');
+    nl buf; (* module name info section *)
+    let len_encoding = make_encoding length buf in 
+    Map_string.iter db (fun _ module_info ->       
+        len_encoding buf 
+          (Hash_string.find_exn  mapping module_info.dir lsl 1 + Obj.magic module_info.case ));      
+    nl buf 
+  end
 let encode (dbs : Bsb_db.t) buf =     
   encode_single dbs.lib buf ;
   encode_single dbs.dev buf 
-  (* Ext_buffer.add_char_string buf '\n' (string_of_int (Array.length dbs)); 
-  Ext_array.iter dbs (fun x ->  encode_single x  buf) *)
-  
 
-(* TODO: shall we avoid writing such file (checking the digest) *)
+
+(*  shall we avoid writing such file (checking the digest)?
+  It is expensive to start scanning the whole code base,
+  we should we avoid it in the first place, if we do start scanning,
+  this operation seems affordable
+ *)
 let write_build_cache ~dir (bs_files : Bsb_db.t)  : string = 
   let oc = open_out_bin (Filename.concat dir bsbuild_cache) in 
   let buf = Ext_buffer.create 100_000 in 
   encode bs_files buf ; 
-  let digest = Ext_buffer.digest buf in 
-  let hex_digest = Digest.to_hex digest in
-  output_string oc digest;
   Ext_buffer.output_buffer oc buf;
   close_out oc; 
-  hex_digest
+  let digest = Ext_buffer.digest buf in 
+  Digest.to_hex digest 
 
 end
 module Ext_digest : sig