WIP

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -244,8 +244,8 @@ let generate_prelude ~out_file =
   @@ fun ch ->
   let code, uinfo = Parse_bytecode.predefined_exceptions () in
   let profile = Profile.O1 in
-  let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
-    Driver.optimize ~profile code
+  let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ }, global_flow_data =
+    Driver.optimize_for_wasm ~profile code
   in
   let context = Generate.start () in
   let _ =
@@ -255,6 +255,7 @@ let generate_prelude ~out_file =
       ~live_vars:variable_uses
       ~in_cps
       ~deadcode_sentinal
+      ~global_flow_data
       program
   in
   Generate.wasm_output ch ~opt_source_map_file:None ~context;
@@ -396,8 +397,9 @@ let run
     check_debug one;
     let code = one.code in
     let standalone = Option.is_none unit_name in
-    let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
-      Driver.optimize ~profile code
+    let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ }, global_flow_data
+        =
+      Driver.optimize_for_wasm ~profile code
     in
     let context = Generate.start () in
     let toplevel_name, generated_js =
@@ -407,6 +409,7 @@ let run
         ~live_vars:variable_uses
         ~in_cps
         ~deadcode_sentinal
+        ~global_flow_data
         program
     in
     if standalone then Generate.add_start_function ~context toplevel_name;

compiler/lib-wasm/generate.ml

@@ -1490,9 +1490,9 @@ let init = G.init
 
 let start () = make_context ~value_type:Gc_target.Type.value
 
-let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal =
-  let state, info = Global_flow.f' ~fast:false p in
-  let types = Typing.f ~state ~info p in
+let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~global_flow_data =
+  let state, info = global_flow_data in
+  let types = Typing.f ~state ~info ~deadcode_sentinal p in
   let t = Timer.make () in
   let p = fix_switch_branches p in
   let res = G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~types p in

compiler/lib-wasm/generate.mli

@@ -27,6 +27,7 @@ val f :
   -> live_vars:int array
   -> in_cps:Effects.in_cps
   -> deadcode_sentinal:Code.Var.t
+  -> global_flow_data:Global_flow.state * Global_flow.info
   -> Wasm_ast.var * (string * Javascript.expression) list
 
 val add_start_function : context:Code_generation.context -> Wasm_ast.var -> unit

compiler/lib-wasm/typing.ml

@@ -414,10 +414,11 @@ let solver st =
   in
   Solver.f () g (propagate st)
 
-let f ~state ~info p =
+let f ~state ~info ~deadcode_sentinal p =
   update_deps state p;
   let function_parameters = mark_function_parameters p in
   let typ = solver { state; info; function_parameters } in
+  Var.Tbl.set typ deadcode_sentinal (Int Normalized);
   if debug ()
   then (
     Var.ISet.iter

compiler/lib-wasm/typing.mli

@@ -21,4 +21,8 @@ type typ =
 val constant_type : Code.constant -> typ
 
 val f :
-  state:Global_flow.state -> info:Global_flow.info -> Code.program -> typ Code.Var.Tbl.t
+     state:Global_flow.state
+  -> info:Global_flow.info
+  -> deadcode_sentinal:Code.Var.t
+  -> Code.program
+  -> typ Code.Var.Tbl.t

compiler/lib/driver.ml

@@ -93,16 +93,18 @@ let phi p =
 
 let ( +> ) f g x = g (f x)
 
-let map_fst f (x, y, z) = f x, y, z
+let map_fst f (x, y) = f x, y
 
-let effects_and_exact_calls ~deadcode_sentinal (profile : Profile.t) p =
+let effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal (profile : Profile.t) p =
   let fast =
     match Config.effects (), profile with
     | (`Cps | `Double_translation), _ -> false
     | _, (O2 | O3) -> false
     | _, O1 -> true
   in
-  let info = Global_flow.f ~fast p in
+  let global_flow_data = Global_flow.f ~fast p in
+  let _, info = global_flow_data in
+  let global_flow_data = if keep_flow_data then Some global_flow_data else None in
   let pure_fun = Pure_fun.f p in
   let p, live_vars =
     if Config.Flag.globaldeadcode () && Config.Flag.deadcode ()
@@ -114,7 +116,8 @@ let effects_and_exact_calls ~deadcode_sentinal (profile : Profile.t) p =
   match Config.effects () with
   | `Cps | `Double_translation ->
       if debug () then Format.eprintf "Effects...@.";
-      Effects.f ~flow_info:info ~live_vars p
+      let p, trampolined_calls, in_cps = Effects.f ~flow_info:info ~live_vars p in
+      (p, (trampolined_calls, in_cps, None))
       |> map_fst
            (match Config.target () with
            | `Wasm -> Fun.id
@@ -124,8 +127,9 @@ let effects_and_exact_calls ~deadcode_sentinal (profile : Profile.t) p =
         Specialize.f ~function_arity:(fun f -> Global_flow.function_arity info f) p
       in
       ( p
-      , (Code.Var.Set.empty : Effects.trampolined_calls)
-      , (Code.Var.Set.empty : Effects.in_cps) )
+      , ( (Code.Var.Set.empty : Effects.trampolined_calls)
+        , (Code.Var.Set.empty : Effects.in_cps)
+        , global_flow_data ) )
 
 let print p =
   if debug () then Code.Print.program Format.err_formatter (fun _ _ -> "") p;
@@ -613,7 +617,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p
   |> pack ~wrap_with_fun ~standalone
   |> check_js
 
-let optimize ~profile p =
+let optimize ~profile ~keep_flow_data p =
   let deadcode_sentinal =
     (* If deadcode is disabled, this field is just fresh variable *)
     Code.Var.fresh_n "dummy"
@@ -626,7 +630,7 @@ let optimize ~profile p =
        | O2 -> o2
        | O3 -> o3)
     +> specialize_js_once_after
-    +> effects_and_exact_calls ~deadcode_sentinal profile
+    +> effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal profile
     +> map_fst
          (match Config.target (), Config.effects () with
          | `JavaScript, `Disabled -> Generate_closure.f
@@ -637,12 +641,20 @@ let optimize ~profile p =
   in
   if times () then Format.eprintf "Start Optimizing...@.";
   let t = Timer.make () in
-  let (program, variable_uses), trampolined_calls, in_cps = opt p in
+  let (program, variable_uses), (trampolined_calls, in_cps, global_flow_info) = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
-  { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal }
+  ( { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal }
+  , global_flow_info )
+
+let optimize_for_wasm ~profile p =
+  let optimized_code, global_flow_data = optimize ~profile ~keep_flow_data:true p in
+  ( optimized_code
+  , match global_flow_data with
+    | Some data -> data
+    | None -> Global_flow.f ~fast:false optimized_code.program )
 
 let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter p =
-  let optimized_code = optimize ~profile p in
+  let optimized_code, _ = optimize ~profile ~keep_flow_data:false p in
   let exported_runtime = not standalone in
   let emit formatter =
     generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone

compiler/lib/driver.mli

@@ -26,7 +26,10 @@ type optimized_result =
   ; deadcode_sentinal : Code.Var.t
   }
 
-val optimize : profile:Profile.t -> Code.program -> optimized_result
+val optimize_for_wasm :
+     profile:Profile.t
+  -> Code.program
+  -> optimized_result * (Global_flow.state * Global_flow.info)
 
 val f :
      ?standalone:bool

compiler/lib/global_flow.ml

@@ -691,7 +691,7 @@ type info =
   ; info_return_vals : Var.Set.t Var.Map.t
   }
 
-let f' ~fast p =
+let f ~fast p =
   let t = Timer.make () in
   let t1 = Timer.make () in
   let rets = return_values p in
@@ -793,8 +793,6 @@ let f' ~fast p =
     ; info_return_vals = rets
     } )
 
-let f ~fast p = snd (f' ~fast p)
-
 let exact_call info f n =
   match Var.Tbl.get info.info_approximation f with
   | Top | Values { others = true; _ } -> false

compiler/lib/global_flow.mli

@@ -78,9 +78,7 @@ type state =
   ; fast : bool
   }
 
-val f : fast:bool -> Code.program -> info
-
-val f' : fast:bool -> Code.program -> state * info
+val f : fast:bool -> Code.program -> state * info
 
 val exact_call : info -> Var.t -> int -> bool