Compiler: fix inlining 2106

Author: hhugo

compiler/lib/duplicate.ml

@@ -60,8 +60,15 @@ let rec blocks_to_rename p pc lst =
     p.blocks
     lst
 
-let closure p ~f ~params ~cont =
-  let s = Subst.from_map (bound_variables p ~f ~params ~cont) in
+let closure p ~f ~params ~cont live_vars =
+  let s =
+    let map = bound_variables p ~f ~params ~cont in
+    fun x ->
+      try Var.Map.find x map
+      with Not_found ->
+        live_vars.(Var.idx x) <- live_vars.(Var.idx x) + 1;
+        x
+  in
   let pc, args = cont in
   let blocks = blocks_to_rename p pc [] in
   let free_pc, m =

compiler/lib/duplicate.mli

@@ -21,6 +21,7 @@ val closure :
   -> f:Code.Var.t
   -> params:Code.Var.t list
   -> cont:int * Code.Var.t list
+  -> int Array.t
   -> Code.program * Code.Var.t * Code.Var.t list * (int * Code.Var.t list)
 (** Given a program and a closure [f] -- defined by its name,
     parameters, and its continuation --, return a program with a copy

compiler/lib/inline.ml

@@ -643,7 +643,9 @@ and inline_function ~context i x f args rem state =
     let p, params, cont =
       if context.live_vars.(Var.idx f) > 0
       then (
-        let p, _f, params, cont = Duplicate.closure p ~f ~params ~cont in
+        let p, _f, params, cont =
+          Duplicate.closure p ~f ~params ~cont context.live_vars
+        in
         (* It's ok to ignore the [_f] because the function is not recursive *)
         assert (not info.recursive);
         p, params, cont)

compiler/tests-compiler/gh2106.ml

@@ -41,47 +41,33 @@ end
   in
   let p = compile_and_parse ~flags:[ "--debug"; "js_assign" ] p in
   print_program p;
-  [%expect.unreachable]
-[@@expect.uncaught_exn {|
-  (* CR expect_test_collector: This test expectation appears to contain a backtrace.
-     This is strongly discouraged as backtraces are fragile.
-     Please change this test to not include a backtrace. *)
-  (Failure "non-zero exit code")
-  Raised at Stdlib__Buffer.add_channel in file "buffer.ml", line 213, characters 18-35
-  Called from Jsoo_compiler_expect_tests_helper__Util.channel_to_string.loop in file "compiler/tests-compiler/util/util.ml", line 169, characters 4-52
-  Called from Jsoo_compiler_expect_tests_helper__Util.channel_to_string in file "compiler/tests-compiler/util/util.ml", line 172, characters 7-14
-
-  Trailing output
-  ---------------
-  (function(globalThis){
-     "use strict";
-     var
-      runtime = globalThis.jsoo_runtime,
-      caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace;
-     function caml_call1(f, a0){
-      return (f.l >= 0 ? f.l : f.l = f.length) === 1
-              ? f(a0)
-              : runtime.caml_call_gen(f, [a0]);
-     }
-     var
-      global_data = runtime.caml_get_global_data(),
-      Assert_failure = global_data.Assert_failure,
-      _a_ = [0, runtime.caml_string_of_jsbytes("test.ml"), 12, 38],
-      dummy = 0;
-     runtime.foo
-      (function(param){
-        caml_call1(<v30{f}>, dummy);
-        throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1);
-       });
-     var X = [0], Test = [0, X];
-     runtime.caml_register_global(2, Test, "Test");
-     return;
-    }
-    (globalThis));
-  Some variables escaped: <v30{f}>
-  /home/hugo/js_of_ocaml/_build/default/compiler/bin-js_of_ocaml/js_of_ocaml.exe: You found a bug. Please report it at https://github.com/ocsigen/js_of_ocaml/issues :
-  Error: File "compiler/lib/js_assign.ml", line 503, characters 5-11: Assertion failed
-
-  process exited with error code 125
-   /home/hugo/js_of_ocaml/_build/default/compiler/bin-js_of_ocaml/js_of_ocaml.exe --pretty --debug var --sourcemap --effects=disabled --disable=use-js-string --disable header --debug js_assign --Werror test.cmo -o test.js
-  |}]
+  [%expect
+    {|
+    (function(globalThis){
+       "use strict";
+       var
+        runtime = globalThis.jsoo_runtime,
+        caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace,
+        global_data = runtime.caml_get_global_data(),
+        Assert_failure = global_data.Assert_failure,
+        _a_ = [0, runtime.caml_string_of_jsbytes("test.ml"), 12, 38];
+       runtime.foo
+        (function(param){
+          function f(param){
+           throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1);
+          }
+          var block = [0, f(0), 24029], dst = block, offset = 1;
+          for(;;){
+           var dst$0 = [0, f(0), 24029];
+           dst[offset + 1] = dst$0;
+           dst = dst$0;
+           offset = 1;
+          }
+         });
+       var X = [0], Test = [0, X];
+       runtime.caml_register_global(2, Test, "Test");
+       return;
+      }
+      (globalThis));
+    //end
+    |}]