control write-shape

ocsigen · Nov 4, 2024 · 14fe546 · 14fe546
1 parent 6e3ff67
commit 14fe546
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 7 deletions.
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -54,6 +54,7 @@ type t =
   ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ]
   ; target_env : Target_env.t
   ; shape_files : string list
+  ; shapes : bool
   ; (* toplevel *)
     dynlink : bool
   ; linkall : bool
@@ -107,6 +108,10 @@ let options =
     let doc = "load shape file [$(docv)]." in
     Arg.(value & opt_all string [] & info [ "load" ] ~docv:"FILE" ~doc)
   in
+  let shapes =
+    let doc = "Emit shape files" in
+    Arg.(value & flag & info [ "shapes" ] ~doc)
+  in
   let input_file =
     let doc =
       "Compile the bytecode program [$(docv)]. "
@@ -285,6 +290,7 @@ let options =
       input_file
       js_files
       shape_files
+      shapes
       keep_unit_names =
     let inline_source_content = not sourcemap_don't_inline_content in
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
@@ -348,6 +354,7 @@ let options =
       ; source_map
       ; keep_unit_names
       ; shape_files
+      ; shapes
       }
   in
   let t =
@@ -379,6 +386,7 @@ let options =
       $ input_file
       $ js_files
       $ shape_files
+      $ shapes
       $ keep_unit_names)
   in
   Term.ret t
@@ -576,6 +584,7 @@ let options_runtime_only =
       ; source_map
       ; keep_unit_names = false
       ; shape_files = []
+      ; shapes = false
       }
   in
   let t =

diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli
@@ -38,6 +38,7 @@ type t =
       ]
   ; target_env : Target_env.t
   ; shape_files : string list
+  ; shapes : bool
   ; (* toplevel *)
     dynlink : bool
   ; linkall : bool

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
@@ -46,19 +46,28 @@ let source_map_enabled = function
   | No_sourcemap -> false
   | Inline | File _ -> true
 
-let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f =
+let output_gen
+    ~write_shapes
+    ~standalone
+    ~custom_header
+    ~build_info
+    ~source_map
+    output_file
+    f =
   let f chan k =
     let fmt = Pretty_print.to_out_channel chan in
     Driver.configure fmt;
     if standalone then header ~custom_header fmt;
     if Config.Flag.header () then jsoo_header fmt build_info;
     let sm, shapes = f ~standalone ~source_map (k, fmt) in
-    (match output_file with
-    | `Stdout -> ()
-    | `Name name ->
-        Shape.Store.save'
-          (Filename.remove_extension name ^ Shape.Store.ext)
-          (StringMap.bindings shapes));
+    (if write_shapes
+     then
+       match output_file with
+       | `Stdout -> ()
+       | `Name name ->
+           Shape.Store.save'
+             (Filename.remove_extension name ^ Shape.Store.ext)
+             (StringMap.bindings shapes));
     match source_map, sm with
     | No_sourcemap, _ | _, None -> ()
     | ((Inline | File _) as output), Some sm ->
@@ -164,6 +173,7 @@ let run
     ; keep_unit_names
     ; include_runtime
     ; shape_files
+    ; shapes = write_shapes
     } =
   let source_map_base = Option.map ~f:snd source_map in
   let source_map =
@@ -378,6 +388,7 @@ let run
         }
       in
       output_gen
+        ~write_shapes
         ~standalone:true
         ~custom_header
         ~build_info:(Build_info.create `Runtime)
@@ -426,6 +437,7 @@ let run
           in
           if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
           output_gen
+            ~write_shapes
             ~standalone:true
             ~custom_header
             ~build_info:(Build_info.create `Exe)
@@ -464,6 +476,7 @@ let run
           in
           if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
           output_gen
+            ~write_shapes
             ~standalone:false
             ~custom_header
             ~build_info:(Build_info.create `Cmo)
@@ -494,6 +507,7 @@ let run
                    failwith "use [-o dirname/] or remove [--keep-unit-names]"
              in
              output_gen
+               ~write_shapes
                ~standalone:false
                ~custom_header
                ~build_info:(Build_info.create `Runtime)
@@ -530,6 +544,7 @@ let run
                   t1
                   (Ocaml_compiler.Cmo_format.name cmo);
               output_gen
+                ~write_shapes
                 ~standalone:false
                 ~custom_header
                 ~build_info:(Build_info.create `Cma)
@@ -579,6 +594,7 @@ let run
             , shapes )
           in
           output_gen
+            ~write_shapes
             ~standalone:false
             ~custom_header
             ~build_info:(Build_info.create `Cma)

diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml
@@ -102,6 +102,8 @@ module Flag = struct
 
   let es6 = o ~name:"es6" ~default:false
 
+  let shapes = o ~name:"shapes" ~default:false
+
   let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false
 end
 

diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli
@@ -75,6 +75,8 @@ module Flag : sig
 
   val es6 : unit -> bool
 
+  val shapes : unit -> bool
+
   val load_shapes_auto : unit -> bool
 
   val enable : string -> unit