Merge pull request #3884 from BuckleScript/snapshot_for_4.06

Snapshot compiler upgrade not using temporary file

Author: bobzhang

lib/4.06.1/bsdep.ml

@@ -770,6 +770,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1269,6 +1272,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file

lib/4.06.1/bspp.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file

lib/4.06.1/bsppx.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file

lib/4.06.1/unstable/bspack.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file

lib/4.06.1/unstable/js_compiler.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file
@@ -57055,8 +57064,9 @@ let record_value_dependency vd1 vd2 =
 
 let save_cmt filename modname binary_annots sourcefile initial_env cmi =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
+    (if !Clflags.bs_only then Misc.output_to_bin_file_directly else 
     Misc.output_to_file_via_temporary
-       ~mode:[Open_binary] filename
+       ~mode:[Open_binary] ) filename
        (fun temp_file_name oc ->
          let this_crc =
            match cmi with

lib/4.06.1/unstable/native_ppx.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file

lib/4.06.1/whole_compiler.ml

@@ -707,6 +707,9 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
+           
+val output_to_bin_file_directly: string -> (string -> out_channel -> 'a) -> 'a
+
 val output_to_file_via_temporary:
       ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
         (* Produce output in temporary file, then rename it
@@ -1206,6 +1209,12 @@ let string_of_file ic =
       (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
+let output_to_bin_file_directly filename fn =  
+  let oc = Pervasives.open_out_bin filename in 
+  match fn filename oc with 
+  | v -> close_out oc ; v 
+  | exception e -> close_out oc ; raise e
+
 let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
   let (temp_filename, oc) =
     Filename.open_temp_file
@@ -45313,8 +45322,9 @@ let record_value_dependency vd1 vd2 =
 
 let save_cmt filename modname binary_annots sourcefile initial_env cmi =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
+    (if !Clflags.bs_only then Misc.output_to_bin_file_directly else 
     Misc.output_to_file_via_temporary
-       ~mode:[Open_binary] filename
+       ~mode:[Open_binary] ) filename
        (fun temp_file_name oc ->
          let this_crc =
            match cmi with