fix rescript-lang#3657

Author: bobzhang

jscomp/bsb/bsb_namespace_map_gen.ml

@@ -28,17 +28,44 @@ let (//) = Ext_path.combine
 
 
 
-
-let output ~dir namespace 
+let write_file fname digest contents = 
+  let oc = open_out_bin fname in 
+  Digest.output oc digest;
+  output_char oc '\n';
+  output_string oc contents;
+  close_out oc 
+(** 
+  TODO:
+  sort filegroupts to ensure deterministic behavior
+  
+  if [.bsbuild] is not changed
+  [.mlmap] does not need to be changed too
+  
+*)
+let output 
+    ~dir 
+    (namespace : string)
     (file_groups : Bsb_file_groups.file_groups )
   = 
   let fname = namespace ^ Literals.suffix_mlmap in 
-  let oc = open_out_bin (dir// fname ) in 
-  List.iter
-    (fun  (x : Bsb_file_groups.file_group) ->
-      String_map.iter x.sources (fun k _ -> 
-        output_string oc k ;
-        output_string oc "\n"
-      ) 
-     )  file_groups ;
-  close_out oc 
+  let buf = Buffer.create 10000 in   
+  Ext_list.iter file_groups 
+    (fun  x ->
+       String_map.iter x.sources (fun k _ -> 
+           Buffer.add_string buf k ;
+           Buffer.add_char buf '\n'
+         ) 
+    );
+  let contents = Buffer.contents buf in   
+  let digest = Digest.string contents in 
+  let fname = (dir// fname ) in 
+  if Sys.file_exists fname then
+    let ic = open_in_bin fname in 
+    let old_digest = really_input_string ic Ext_pervasives.digest_length in 
+    close_in ic ;
+    (if old_digest <> digest then 
+      write_file fname digest contents)
+  else 
+    write_file fname digest contents
+    
+  

jscomp/core/js_implementation.ml

@@ -190,16 +190,20 @@ let make_structure_item ~ns cunit : Parsetree.structure_item =
           ; loc}))
 
 
-
+(** decoding [.mlmap]
+  keep in sync {!Bsb_namespace_map_gen.output}
+*)
 let implementation_map ppf sourcefile outputprefix = 
-  let list_of_modules = Ext_io.rev_lines_of_file sourcefile 
-  in 
+  let ichan = open_in_bin sourcefile in 
+  seek_in ichan (Ext_pervasives.digest_length +1);
+  let list_of_modules = Ext_io.rev_lines_of_chann ichan in 
+  close_in ichan;
   let ns = 
     Ext_string.capitalize_ascii
       (Filename.chop_extension (Filename.basename sourcefile)) in
-  let ml_ast = Ext_list.fold_left list_of_modules [] (fun acc module_name -> 
-      if Ext_string.is_empty module_name then acc 
-      else make_structure_item ~ns module_name :: acc 
+  let ml_ast = Ext_list.fold_left list_of_modules [] (fun acc line -> 
+      if Ext_string.is_empty line then acc 
+      else make_structure_item ~ns line :: acc 
     )  in 
   Compmisc.init_path false;
   ml_ast

jscomp/ext/ext_io.ml

@@ -33,14 +33,17 @@ let load_file f =
   end
 
 
-let rev_lines_of_file file = 
-  Ext_pervasives.finally (open_in_bin file) close_in begin fun chan -> 
-    let rec loop acc = 
+let  rev_lines_of_chann chan = 
+    let rec loop acc chan = 
       match input_line chan with
-      | line -> loop (line :: acc)
+      | line -> loop (line :: acc) chan
       | exception End_of_file -> close_in chan ; acc in
-    loop []
-  end
+    loop [] chan
+
+
+let rev_lines_of_file file = 
+  Ext_pervasives.finally (open_in_bin file) close_in rev_lines_of_chann
+  
 
 let write_file f content = 
   Ext_pervasives.finally (open_out_bin f) close_out begin fun oc ->   

jscomp/ext/ext_io.mli

@@ -26,4 +26,6 @@ val load_file : string -> string
 
 val rev_lines_of_file : string -> string list
 
+val rev_lines_of_chann : in_channel -> string list
+
 val write_file : string -> string -> unit

jscomp/ext/ext_pervasives.ml

@@ -83,4 +83,6 @@ let hash_variant s =
   if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
 
 let todo loc = 
-  failwith (loc ^ " Not supported yet")
+  failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  

jscomp/ext/ext_pervasives.mli

@@ -60,4 +60,6 @@ external id : 'a -> 'a = "%identity"
  *)
 val hash_variant : string -> int
 
-val todo : string -> 'a
+val todo : string -> 'a
+
+val digest_length : int

lib/4.02.3/bsb.ml

@@ -458,6 +458,8 @@ external id : 'a -> 'a = "%identity"
 val hash_variant : string -> int
 
 val todo : string -> 'a
+
+val digest_length : int
 end = struct
 #1 "ext_pervasives.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -546,6 +548,8 @@ let hash_variant s =
 
 let todo loc = 
   failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  
 end
 module Ext_string : sig 
 #1 "ext_string.mli"
@@ -12853,20 +12857,47 @@ let (//) = Ext_path.combine
 
 
 
-
-let output ~dir namespace 
+let write_file fname digest contents = 
+  let oc = open_out_bin fname in 
+  Digest.output oc digest;
+  output_char oc '\n';
+  output_string oc contents;
+  close_out oc 
+(** 
+  TODO:
+  sort filegroupts to ensure deterministic behavior
+  
+  if [.bsbuild] is not changed
+  [.mlmap] does not need to be changed too
+  
+*)
+let output 
+    ~dir 
+    (namespace : string)
     (file_groups : Bsb_file_groups.file_groups )
   = 
   let fname = namespace ^ Literals.suffix_mlmap in 
-  let oc = open_out_bin (dir// fname ) in 
-  List.iter
-    (fun  (x : Bsb_file_groups.file_group) ->
-      String_map.iter x.sources (fun k _ -> 
-        output_string oc k ;
-        output_string oc "\n"
-      ) 
-     )  file_groups ;
-  close_out oc 
+  let buf = Buffer.create 10000 in   
+  Ext_list.iter file_groups 
+    (fun  x ->
+       String_map.iter x.sources (fun k _ -> 
+           Buffer.add_string buf k ;
+           Buffer.add_char buf '\n'
+         ) 
+    );
+  let contents = Buffer.contents buf in   
+  let digest = Digest.string contents in 
+  let fname = (dir// fname ) in 
+  if Sys.file_exists fname then
+    let ic = open_in_bin fname in 
+    let old_digest = really_input_string ic Ext_pervasives.digest_length in 
+    close_in ic ;
+    (if old_digest <> digest then 
+      write_file fname digest contents)
+  else 
+    write_file fname digest contents
+    
+  
 end
 module Bsb_ninja_global_vars
 = struct
@@ -16875,6 +16906,8 @@ val load_file : string -> string
 
 val rev_lines_of_file : string -> string list
 
+val rev_lines_of_chann : in_channel -> string list
+
 val write_file : string -> string -> unit
 
 end = struct
@@ -16914,14 +16947,17 @@ let load_file f =
   end
 
 
-let rev_lines_of_file file = 
-  Ext_pervasives.finally (open_in_bin file) close_in begin fun chan -> 
-    let rec loop acc = 
+let  rev_lines_of_chann chan = 
+    let rec loop acc chan = 
       match input_line chan with
-      | line -> loop (line :: acc)
+      | line -> loop (line :: acc) chan
       | exception End_of_file -> close_in chan ; acc in
-    loop []
-  end
+    loop [] chan
+
+
+let rev_lines_of_file file = 
+  Ext_pervasives.finally (open_in_bin file) close_in rev_lines_of_chann
+  
 
 let write_file f content = 
   Ext_pervasives.finally (open_out_bin f) close_out begin fun oc ->   

lib/4.02.3/bsb_helper.ml

@@ -797,6 +797,8 @@ external id : 'a -> 'a = "%identity"
 val hash_variant : string -> int
 
 val todo : string -> 'a
+
+val digest_length : int
 end = struct
 #1 "ext_pervasives.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -885,6 +887,8 @@ let hash_variant s =
 
 let todo loc = 
   failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  
 end
 module Ext_string : sig 
 #1 "ext_string.mli"

lib/4.02.3/bsdep.ml

@@ -23247,6 +23247,8 @@ external id : 'a -> 'a = "%identity"
 val hash_variant : string -> int
 
 val todo : string -> 'a
+
+val digest_length : int
 end = struct
 #1 "ext_pervasives.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -23335,6 +23337,8 @@ let hash_variant s =
 
 let todo loc = 
   failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  
 end
 module Ext_string : sig 
 #1 "ext_string.mli"

lib/4.02.3/bsppx.ml

@@ -579,6 +579,8 @@ external id : 'a -> 'a = "%identity"
 val hash_variant : string -> int
 
 val todo : string -> 'a
+
+val digest_length : int
 end = struct
 #1 "ext_pervasives.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -667,6 +669,8 @@ let hash_variant s =
 
 let todo loc = 
   failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  
 end
 module Ext_string : sig 
 #1 "ext_string.mli"

lib/4.02.3/unstable/all_ounit_tests.ml

@@ -1924,6 +1924,8 @@ external id : 'a -> 'a = "%identity"
 val hash_variant : string -> int
 
 val todo : string -> 'a
+
+val digest_length : int
 end = struct
 #1 "ext_pervasives.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -2012,6 +2014,8 @@ let hash_variant s =
 
 let todo loc = 
   failwith (loc ^ " Not supported yet")
+
+let digest_length = 16  
 end
 module Ext_string : sig 
 #1 "ext_string.mli"