Compiler: refactor profile handling

hhugo · hhugo · commit c599c2c37ce8 · 2025-05-16T12:38:22.000+02:00
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -53,7 +53,7 @@ let normalize_effects (effects : [ `Cps | `Double_translation ] option) common :
 type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
-    profile : Driver.profile option
+    profile : Profile.t option
   ; source_map : Source_map.Encoding_spec.t option
   ; runtime_files : string list
   ; no_runtime : bool
@@ -127,7 +127,9 @@ let options =
   in
   let profile =
     let doc = "Set optimization profile : [$(docv)]." in
-    let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
+    let profile =
+      List.map Profile.all ~f:(fun p -> string_of_int (Profile.to_int p), p)
+    in
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
   let noruntime =
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli
@@ -22,7 +22,7 @@ open Js_of_ocaml_compiler
 type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
-    profile : Driver.profile option
+    profile : Profile.t option
   ; source_map : Source_map.Encoding_spec.t option
   ; runtime_files : string list
   ; no_runtime : bool
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -52,7 +52,7 @@ let normalize_effects (effects : [ `Cps | `Jspi ] option) common : Config.effect
 type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
-    profile : Driver.profile option
+    profile : Profile.t option
   ; runtime_files : string list
   ; runtime_only : bool
   ; output_file : string * bool
@@ -80,7 +80,9 @@ let options () =
   in
   let profile =
     let doc = "Set optimization profile : [$(docv)]." in
-    let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
+    let profile =
+      List.map Profile.all ~f:(fun p -> string_of_int (Profile.to_int p), p)
+    in
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
   let linkall =
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -21,7 +21,7 @@ open Js_of_ocaml_compiler
 type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
-    profile : Driver.profile option
+    profile : Profile.t option
   ; runtime_files : string list
   ; runtime_only : bool
   ; output_file : string * bool
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -232,11 +232,7 @@ let generate_prelude ~out_file =
   Filename.gen_file out_file
   @@ fun ch ->
   let code, uinfo = Parse_bytecode.predefined_exceptions () in
-  let profile =
-    match Driver.profile 1 with
-    | Some p -> p
-    | None -> assert false
-  in
+  let profile = Profile.O1 in
   let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
     Driver.optimize ~profile code
   in
@@ -260,7 +256,7 @@ let build_prelude z =
   @@ fun tmp_prelude_file ->
   let predefined_exceptions = generate_prelude ~out_file:prelude_file in
   Binaryen.optimize
-    ~profile:(Driver.profile 1)
+    ~profile:Profile.O1
     ~input_file:prelude_file
     ~output_file:tmp_prelude_file
     ~opt_input_sourcemap:None
@@ -389,16 +385,15 @@ let run
          Warning: Consider passing '-g' option to ocamlc.\n\
          %!"
   in
+  let profile =
+    match profile with
+    | Some p -> p
+    | None -> Profile.O1
+  in
   let output (one : Parse_bytecode.one) ~unit_name ch =
     check_debug one;
     let code = one.code in
     let standalone = Option.is_none unit_name in
-    let profile =
-      match profile, Driver.profile 1 with
-      | Some p, _ -> p
-      | None, Some p -> p
-      | None, None -> assert false
-    in
     let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
       Driver.optimize ~profile code
     in
diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml
@@ -110,11 +110,10 @@ let dead_code_elimination
        @ [ ">"; Filename.quote usage_file ]));
   filter_unused_primitives primitives usage_file
 
-let optimization_options =
-  [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-  |]
+let optimization_options : Profile.t -> _ = function
+  | O1 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+  | O2 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+  | O3 -> [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
 
 let optimize
     ~profile
@@ -124,16 +123,12 @@ let optimize
     ~opt_output_sourcemap
     ~output_file
     () =
-  let level =
-    match profile with
-    | None -> 1
-    | Some p ->
-        fst (List.find ~f:(fun (_, p') -> Driver.profile_equal p p') Driver.profiles)
-  in
   command
     ("wasm-opt"
      :: (common_options ()
-        @ Option.value ~default:optimization_options.(level - 1) options
+        @ (match options with
+          | Some o -> o
+          | None -> optimization_options profile)
         @ [ Filename.quote input_file; "-o"; Filename.quote output_file ])
     @ opt_flag "--input-source-map" opt_input_sourcemap
     @ opt_flag "--output-source-map" opt_output_sourcemap)
diff --git a/compiler/lib-wasm/binaryen.mli b/compiler/lib-wasm/binaryen.mli
@@ -38,7 +38,7 @@ val dead_code_elimination :
   -> Stdlib.StringSet.t
 
 val optimize :
-     profile:Driver.profile option
+     profile:Profile.t
   -> ?options:string list
   -> opt_input_sourcemap:string option
   -> input_file:string
diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml
@@ -12,7 +12,7 @@ let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output
     ~output_file:merge_file
     ());
   Binaryen.optimize
-    ~profile:None
+    ~profile:Profile.O1
     ~options:opt_options
     ~opt_input_sourcemap:None
     ~input_file:merge_file
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
@@ -31,13 +31,6 @@ type optimized_result =
   ; deadcode_sentinal : Code.Var.t
   }
 
-type profile =
-  | O1
-  | O2
-  | O3
-
-let profile_equal (a : profile) b = Poly.equal a b
-
 let should_export = function
   | `Iife -> false
   | `Named _ | `Anonymous -> true
@@ -123,7 +116,7 @@ let effects ~deadcode_sentinal p =
       , (Code.Var.Set.empty : Effects.trampolined_calls)
       , (Code.Var.Set.empty : Effects.in_cps) )
 
-let exact_calls profile ~deadcode_sentinal p =
+let exact_calls (profile : Profile.t) ~deadcode_sentinal p =
   match Config.effects () with
   | `Disabled | `Jspi ->
       let fast =
@@ -635,7 +628,7 @@ let optimize ~profile p =
   let opt =
     Specialize.switches
     +> specialize_js_once_before
-    +> (match profile with
+    +> (match (profile : Profile.t) with
        | O1 -> o1
        | O2 -> o2
        | O3 -> o3)
@@ -676,14 +669,20 @@ let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link p =
 let f
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
-    ?(profile = O1)
+    ?(profile = Profile.O1)
     ~link
     ~source_map
     ~formatter
     p =
   full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter p
 
-let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter p =
+let f'
+    ?(standalone = true)
+    ?(wrap_with_fun = `Iife)
+    ?(profile = Profile.O1)
+    ~link
+    formatter
+    p =
   full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link p
 
 let from_string ~prims ~debug s formatter =
@@ -695,7 +694,3 @@ let from_string ~prims ~debug s formatter =
     ~profile:O1
     ~link:`No
     p
-
-let profiles = [ 1, O1; 2, O2; 3, O3 ]
-
-let profile i = List.find_map ~f:(fun (i', p) -> if i = i' then Some p else None) profiles
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
@@ -18,10 +18,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-type profile
-
-val profile_equal : profile -> profile -> bool
-
 type optimized_result =
   { program : Code.program
   ; variable_uses : Deadcode.variable_uses
@@ -30,12 +26,12 @@ type optimized_result =
   ; deadcode_sentinal : Code.Var.t
   }
 
-val optimize : profile:profile -> Code.program -> optimized_result
+val optimize : profile:Profile.t -> Code.program -> optimized_result
 
 val f :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-  -> ?profile:profile
+  -> ?profile:Profile.t
   -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> source_map:bool
   -> formatter:Pretty_print.t
@@ -45,7 +41,7 @@ val f :
 val f' :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-  -> ?profile:profile
+  -> ?profile:Profile.t
   -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> Pretty_print.t
   -> Code.program
@@ -70,7 +66,3 @@ val simplify_js : Javascript.statement_list -> Javascript.statement_list
 val name_variables : Javascript.statement_list -> Javascript.statement_list
 
 val configure : Pretty_print.t -> unit
-
-val profiles : (int * profile) list
-
-val profile : int -> profile option
diff --git a/compiler/lib/profile.ml b/compiler/lib/profile.ml
@@ -0,0 +1,39 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2025 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Stdlib
+
+type t =
+  | O1
+  | O2
+  | O3
+
+let equal (a : t) b =
+  match a, b with
+  | O1, O1 | O2, O2 | O3, O3 -> true
+  | O1, _ | O2, _ | O3, _ -> false
+
+let all = [ O1; O2; O3 ]
+
+let to_int = function
+  | O1 -> 1
+  | O2 -> 2
+  | O3 -> 3
+
+let of_int i = List.find_map ~f:(fun p -> if i = to_int p then Some p else None) all
diff --git a/compiler/lib/profile.mli b/compiler/lib/profile.mli
@@ -0,0 +1,30 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2025 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+type t =
+  | O1
+  | O2
+  | O3
+
+val all : t list
+
+val of_int : int -> t option
+
+val to_int : t -> int
+
+val equal : t -> t -> bool
