Internal API change: introduce and use Compression.input_value

xavierleroy · xavierleroy · commit e5c9d4534a8d · 2023-11-12T18:36:41.000+01:00
Under the hood, it's just `Stdlib.input_value`.
However, it documents the places in the compiler where we expect to read
compressed marshaled data.
diff --git a/.depend b/.depend
@@ -1988,6 +1988,7 @@ bytecomp/bytelink.cmo : \
     bytecomp/dll.cmi \
     utils/consistbl.cmi \
     utils/config.cmi \
+    utils/compression.cmi \
     file_formats/cmo_format.cmi \
     utils/clflags.cmi \
     utils/ccomp.cmi \
@@ -2005,6 +2006,7 @@ bytecomp/bytelink.cmx : \
     bytecomp/dll.cmx \
     utils/consistbl.cmx \
     utils/config.cmx \
+    utils/compression.cmx \
     file_formats/cmo_format.cmi \
     utils/clflags.cmx \
     utils/ccomp.cmx \
@@ -6937,6 +6939,7 @@ tools/dumpobj.cmo : \
     bytecomp/instruct.cmi \
     typing/ident.cmi \
     utils/config.cmi \
+    utils/compression.cmi \
     file_formats/cmo_format.cmi \
     bytecomp/bytesections.cmi \
     tools/dumpobj.cmi
@@ -6949,6 +6952,7 @@ tools/dumpobj.cmx : \
     bytecomp/instruct.cmx \
     typing/ident.cmx \
     utils/config.cmx \
+    utils/compression.cmx \
     file_formats/cmo_format.cmi \
     bytecomp/bytesections.cmx \
     tools/dumpobj.cmi
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
@@ -228,8 +228,10 @@ let link_compunit output_fun currpos_fun inchan file_name compunit =
   Symtable.patch_object code_block compunit.cu_reloc;
   if !Clflags.debug && compunit.cu_debug > 0 then begin
     seek_in inchan compunit.cu_debug;
-    let debug_event_list : Instruct.debug_event list = input_value inchan in
-    let debug_dirs : string list = input_value inchan in
+    let debug_event_list : Instruct.debug_event list =
+      Compression.input_value inchan in
+    let debug_dirs : string list =
+      Compression.input_value inchan in
     let file_path = Filename.dirname (Location.absolute_path file_name) in
     let debug_dirs =
       if List.mem file_path debug_dirs
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
@@ -162,13 +162,13 @@ let rename_append_bytecode packagename oc state objfile compunit =
     let events, debug_dirs =
       if !Clflags.debug && compunit.cu_debug > 0 then begin
         seek_in ic compunit.cu_debug;
-        let unit_events = (input_value ic : debug_event list) in
+        let unit_events = (Compression.input_value ic : debug_event list) in
         let events =
           rev_append_map
             (relocate_debug state.offset packagename state.subst)
             unit_events
             state.events in
-        let unit_debug_dirs = (input_value ic : string list) in
+        let unit_debug_dirs = (Compression.input_value ic : string list) in
         let debug_dirs =
           String.Set.union
             state.debug_dirs
diff --git a/file_formats/cmi_format.ml b/file_formats/cmi_format.ml
@@ -42,7 +42,7 @@ type cmi_infos = {
 }
 
 let input_cmi ic =
-  let (name, sign) = (input_value ic : header) in
+  let (name, sign) = (Compression.input_value ic : header) in
   let crcs = (input_value ic : crcs) in
   let flags = (input_value ic : flags) in
   {
diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml
@@ -105,7 +105,7 @@ let clear_env binary_annots =
 
 exception Error of error
 
-let input_cmt ic = (input_value ic : cmt_infos)
+let input_cmt ic = (Compression.input_value ic : cmt_infos)
 
 let output_cmt oc cmt =
   output_string oc Config.cmt_magic_number;
diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml
@@ -134,7 +134,7 @@ module Bytecode = struct
           if compunit.cu_debug = 0 then [| |]
           else begin
             seek_in ic compunit.cu_debug;
-            [| input_value ic |]
+            [| Compression.input_value ic |]
           end in
         if priv then Symtable.hide_additions old_state;
         let _, clos = Meta.reify_bytecode code events (Some digest) in
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
@@ -468,8 +468,9 @@ let dump_obj ic =
     List.iter print_reloc cu.cu_reloc;
   if cu.cu_debug > 0 then begin
     seek_in ic cu.cu_debug;
-    let evl = (input_value ic : debug_event list) in
-    ignore (input_value ic); (* Skip the list of absolute directory names *)
+    let evl = (Compression.input_value ic : debug_event list) in
+    ignore (Compression.input_value ic);
+                (* Skip the list of absolute directory names *)
     record_events 0 evl
   end;
   seek_in ic cu.cu_pos;
@@ -496,9 +497,9 @@ let dump_exe ic =
         let num_eventlists = input_binary_int ic in
         for _i = 1 to num_eventlists do
           let orig = input_binary_int ic in
-          let evl = (input_value ic : debug_event list) in
+          let evl = (Compression.input_value ic : debug_event list) in
           (* Skip the list of absolute directory names *)
-          ignore (input_value ic);
+          ignore (Compression.input_value ic);
           record_events orig evl
         done
   end;
diff --git a/utils/compression.ml b/utils/compression.ml
@@ -27,3 +27,5 @@ external to_channel: out_channel -> 'a -> extern_flags list -> unit
                    = "caml_output_value"
 
 let output_value ch v = to_channel ch v [Compression]
+
+let input_value = Stdlib.input_value
diff --git a/utils/compression.mli b/utils/compression.mli
@@ -14,13 +14,21 @@
 (**************************************************************************)
 
 val output_value : out_channel -> 'a -> unit
-(** [Compression.outpput_value chan v] writes the representation
+(** [Compression.output_value chan v] writes the representation
     of [v] on channel [chan].
     If compression is supported, the marshaled data
     representing value [v] is compressed before being written to
     channel [chan].
     If compression is not supported, this function behaves like
     {!Stdlib.output_value}. *)
 
+val input_value : in_channel -> 'a
+(** [Compression.input_value chan] reads from channel [chan] the
+    byte representation of a structured value, as produced by
+    [Compression.output_value], and reconstructs and
+    returns the corresponding value.
+    If compression is not supported, this function behaves like
+    {!Stdlib.input_value}. *)
+
 val compression_supported : bool
 (** Reports whether compression is supported. *)

Original file line number	Diff line number	Diff line change
`@@ -42,7 +42,7 @@ type cmi_infos = {`
`42`	`42`	`}`
`43`	`43`
`44`	`44`	`let input_cmi ic =`
`45`		`- let (name, sign) = (input_value ic : header) in`
	`45`	`+ let (name, sign) = (Compression.input_value ic : header) in`
`46`	`46`	`let crcs = (input_value ic : crcs) in`
`47`	`47`	`let flags = (input_value ic : flags) in`
`48`	`48`	`{`